home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Skunkware 98
/
Skunkware 98.iso
/
src
/
interp
/
tclStruct1.2.tar.gz
/
tclStruct1.2.tar
/
tclStruct1.2
/
stTrStr.c
< prev
next >
Wrap
C/C++ Source or Header
|
1995-10-17
|
7KB
|
240 lines
/*
* tclStruct package
* Support 'C' structures in Tcl
*
* Written by Matthew Costello
* (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "stInternal.h"
STRUCT_SCCSID("@(#)tclStruct:stTrStr.c 1.2 95/10/17")
/*
* (Object) Type conversion routines do not follow the
* standard Tcl argument convention because name1+name2
* are processed by the common trace routine above.
*/
/* I/O Char Trace */
char *
Struct_TraceChar(cdata, interp,name1,name2,flags)
ClientData cdata;
Tcl_Interp *interp;
char *name1,*name2;
int flags;
{
Struct_Object *object = (Struct_Object *)cdata;
if (flags & TCL_TRACE_READS) {
if (object->type->flags & STRUCT_FLAG_IS_ARRAY) {
/* Read an array of chars */
char *charbuf;
if ((charbuf = ckalloc( object->size + 1 )) == NULL)
return "can't allocate memory for char result";
memcpy( charbuf, object->data, object->size );
charbuf[object->size] = '\0';
if (object->type->fill != NULL && *object->type->fill) {
/* Remove trailing fill characters */
char *s;
int ch = *object->type->fill;
if ( (*charbuf == '\0') &&
!(object->type->flags & STRUCT_FLAG_NULL_OK) )
return "nul character";
for ( s = charbuf + object->size;
(--s > charbuf) && (*s == ch); )
*s = '\0';
if ( (--s == charbuf) &&
!(object->type->flags & STRUCT_FLAG_NULL_OK) )
*s = '\0';
}
Tcl_SetVar2(interp,name1,name2,charbuf,flags&TCL_GLOBAL_ONLY);
ckfree(charbuf);
} else {
/* Read a simple char : */
static char res[2]={0,0};
res[0] = *((char *)object->data);
if ( (res[0] == '\0') &&
!(object->type->flags & STRUCT_FLAG_NULL_OK) )
return "nul character";
Tcl_SetVar2(interp,name1,name2,res,flags&TCL_GLOBAL_ONLY);
}
} else if (flags & TCL_TRACE_WRITES) {
if (object->type->flags & STRUCT_FLAG_IS_ARRAY) {
/* Write an array of chars */
char *s;
int len;
if ((s = Tcl_GetVar2(interp,name1,name2,flags&TCL_GLOBAL_ONLY)) == NULL)
return "null ptr in char write";
if ( ((len = strlen(s)) > object->size) &&
(object->type->flags & STRUCT_FLAG_STRICT) )
return "char string too long";
else if (len >= object->size ) {
memcpy( (char *)object->data, s, object->size );
#ifdef DEBUG
if (struct_debug & (DBG_CHAR))
printf("Struct_TraceChar: Write char*%d %s with {%s}\n",
object->size, Struct_ObjectName(object,0), s );
#endif
} else if ( (len == 0) && (object->type->flags & STRUCT_FLAG_NULL_OK) ) {
/* If nullok, then write binary zeroes irrespective of fill */
memset( (char *)object->data, 0x00, object->size );
} else {
memcpy( (char *)object->data, s, len );
memset( (char *)object->data + len,
(object->type->fill != NULL) ? *object->type->fill : '\0',
object->size - len );
#ifdef DEBUG
if (struct_debug & (DBG_CHAR)) {
printf("Struct_TraceChar: Write char*%d %s with {%s}",
object->size, Struct_ObjectName(object,0), s );
if (object->type->fill != NULL)
printf(", fill = {%s}", object->type->fill );
printf("\n");
}
#endif
}
} else {
/* Write a single char : */
char *s;
if ((s = Tcl_GetVar2(interp,name1,name2,flags&TCL_GLOBAL_ONLY)) == NULL)
return "null ptr in char write";
if ( (*s == '\0') &&
!(object->type->flags & STRUCT_FLAG_NULL_OK) )
return "nul character";
if ( ((int)strlen(s) > 1) && /* len==0 --> nul char */
(object->type->flags & STRUCT_FLAG_STRICT) )
return "bad char";
*((char*)object->data) = *s; /* len==0 --> nul char */
}
} else {
/* Unset : */
#ifdef DEBUG
printf("\tunset!\n");
#endif
Struct_DeleteObject(object);
}
return NULL;
}
/* I/O Hex Trace */
char *
Struct_TraceHex(cdata, interp,name1,name2,flags)
ClientData cdata;
Tcl_Interp *interp;
char *name1,*name2;
int flags;
{
Struct_Object *object = (Struct_Object *)cdata;
static char hexchar[] = "0123456789abcdef";
if (flags & TCL_TRACE_READS) {
/* Read the object as a Hexadecimal string */
char *hexbuf;
char *p;
unsigned char *s;
int n;
if ((hexbuf = ckalloc( 2 * object->size + 1 )) == NULL)
return "can't allocate memory for hex result";
for ( p = hexbuf, s = object->data, n = object->size; --n >= 0;) {
*p++ = hexchar[*s >> 4];
*p++ = hexchar[*s++ & 0x0f];
}
*p = '\0';
Tcl_SetVar2(interp,name1,name2,hexbuf,flags&TCL_GLOBAL_ONLY);
ckfree(hexbuf);
} else if (flags & TCL_TRACE_WRITES) {
/* Write the object as a Hexadecimal string */
char *s;
char *p;
char *i1, *i2;
int n;
if ((s = Tcl_GetVar2(interp,name1,name2,flags&TCL_GLOBAL_ONLY)) == NULL)
return "null ptr in hex write";
if ((n = strlen(s)) & 01)
return "hex string has odd number of bytes";
if ((n >>= 1) != object->size) {
if (object->type->flags & STRUCT_FLAG_STRICT)
return "incorrect hex string length";
if (n < object->size)
memset( (char *)object->data + n, 0x00, object->size - n );
else
n = object->size;
}
for ( p = object->data; --n >= 0; ) {
if ( ((i1 = strchr(hexchar,*s++)) == NULL) ||
((i2 = strchr(hexchar,*s++)) == NULL) )
return "not a valid hex string";
*p++ = ((i1 - hexchar) << 4) + (i2 - hexchar);
}
} else {
/* Unset : */
#ifdef DEBUG
printf("\tunset!\n");
#endif
Struct_DeleteObject(object);
}
return NULL;
}
/* I/O String Trace */
char *
Struct_TraceString(cdata, interp,name1,name2,flags)
ClientData cdata;
Tcl_Interp *interp;
char *name1,*name2;
int flags;
{
Struct_Object *object = (Struct_Object *)cdata;
if (flags & TCL_TRACE_READS) {
/* Read a string : */
char *s;
/* If the string has a NULL pointer, then either return an
* error or an empty string.
*/
if ((s = *(char **)object->data) != NULL)
Tcl_SetVar2(interp,name1,name2,s,flags&TCL_GLOBAL_ONLY);
else if ( !(object->type->flags & STRUCT_FLAG_NULL_OK) &&
(object->type->flags & STRUCT_FLAG_STRICT) )
return "trying to dereference NULL pointer";
else
Tcl_SetVar2(interp,name1,name2,"",flags&TCL_GLOBAL_ONLY);
} else if (flags & TCL_TRACE_WRITES) {
/* Write a string : */
char *s, *p;
if ((s = Tcl_GetVar2(interp,name1,name2,flags&TCL_GLOBAL_ONLY)) == NULL)
return "null ptr in string write";
/* Free the old string. */
if ((p = *(char **)object->data) != NULL)
ckfree(p);
/* If the user is writing the empty string and NULL_OK
* is set, then set the string pointer to NULL rather
* than having it point to an empty string.
*/
if ( (*s == '\0') &&
(object->type->flags & STRUCT_FLAG_NULL_OK) ) {
*(char **)object->data = NULL;
} else {
int n = strlen(s) + 1;
if ((p = *(char **)object->data = ckalloc(n)) == NULL)
return "failed malloc in string write";
memcpy( p, s, n );
}
} else {
/* Unset : */
#ifdef DEBUG
printf("\tunset!\n");
#endif
Struct_DeleteObject(object);
}
return NULL;
}